home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / xaw / stripchart.d < prev    next >
Encoding:
Text File  |  1991-09-25  |  1.3 KB  |  45 lines
  1. ;;; -*-Scheme-*-
  2.  
  3. (define-widget-type 'stripchart "StripChart.h")
  4.  
  5. (prolog
  6.  
  7. "static void Get_Value (w, client_data, value) Widget w;
  8.     XtPointer client_data; XtPointer value; {
  9.     Object ret;
  10.  
  11.     ret = Funcall (Get_Function ((int)client_data), Null, 0);
  12.     switch (TYPE(ret)) {
  13.     case T_Fixnum: *(double *)value = (double)FIXNUM(ret); break;
  14.     case T_Flonum: *(double *)value = FLONUM(ret)->val; break;
  15.     case T_Bignum: *(double *)value = Bignum_To_Double (ret); break;
  16.     default: Primitive_Error (\"stripchart sampler must return number\");
  17.     }
  18. }")
  19.  
  20. (define-widget-class 'stripchart 'stripChartWidgetClass)
  21.  
  22. (define-primitive 'stripchart-set-sampler '(w p)
  23. "   int i;
  24.     Arg a[1];
  25.     XtCallbackList c;
  26.  
  27.     Check_Widget_Class (w, stripChartWidgetClass);
  28.     Check_Procedure (p);
  29.     XtSetArg (a[0], XtNgetValue, &c);
  30.     XtGetValues (WIDGET(w)->widget, a, 1);
  31.     if (c[0].callback)
  32.     Primitive_Error (\"stripchart already has a sampler\");
  33.     i = Register_Function (p);
  34.     XtAddCallback (WIDGET(w)->widget, XtNgetValue, Get_Value, (XtPointer)i);
  35.     return Make_Id ('s', (XtPointer)WIDGET(w)->widget, i);")
  36.  
  37. (define-primitive 'stripchart-remove-sampler '(i)
  38. "   Widget w;
  39.  
  40.     w = (Widget)Use_Id (i, 's');
  41.     XtRemoveCallback (w, XtNgetValue, Get_Value,
  42.     (XtPointer)IDENTIFIER(i)->num);
  43.     Deregister_Function (IDENTIFIER(i)->num);
  44.     return Void;")
  45.